;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Dialog item creator methods
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmeth homals-dialog-proto :add-dialog-item (items &optional (stick nil))
  (let ((dialog-items (send self :dialog-items)))
    (send self :dialog-items 
         (if stick (append (butlast dialog-items)
                           (list (combine (last dialog-items) items)))
                   (append dialog-items items)))))

(defmeth homals-dialog-proto :add-converge ()
 (let* ((homals-parent (send self :homals-parent))
        (converge-button (send button-item-proto :new "Convergence"
          :action #'(lambda () 
   (let* (
          (eps0-ask (send text-item-proto :new 
                             "Number of Decimal Places for Fit:"))
          (eps0-get (send edit-text-item-proto :new (format nil "~a"
               (round (abs (/ (log (send homals-parent :eps-0)) (log 10)))))
                :text-length 4))
          (eps1-ask (send text-item-proto :new
                             "Number of Decimal Places for Function Change:"))
          (eps1-get (send edit-text-item-proto :new (format nil "~a" 
               (round (abs (/ (log (send homals-parent :eps-1)) (log 10)))))
                :text-length 4))
          (ok (send modal-button-proto :new "Ok" :action #'(lambda ()
                        (send homals-parent :eps-0
                             (read-from-string (send eps0-get :text)))
                        (send homals-parent :eps-1
                             (read-from-string (send eps1-get :text))))))
          (dialog (send modal-dialog-proto :new
                             (list (list eps0-ask eps0-get)
                                   (list eps1-ask eps1-get) ok))))
   (send dialog :modal-dialog))))))
   (send self :add-dialog-item (list converge-button) 't)))
  

(defmeth homals-dialog-proto :add-compute ()
 (let* (
        (homals-parent (send self :homals-parent))
        (ask-dimension (send text-item-proto :new "Solution Dimension:"))
        (plot-dimension (send edit-text-item-proto :new "" :text-length 4))
        (ask-status-name (send text-item-proto :new
                      (pad-string "[Optional] Variable Status Filename:" 37)))
        (show-status-file (send edit-text-item-proto :new "" :text-length 20))
        (compute-button (send button-item-proto :new "Compute"
                :action #'(lambda ()
                  (let ((dim (send plot-dimension :text)))
                    (if (natural-numberp dim)
                        (progn
                         (send homals-parent :p (floor (read-from-string dim)))
                         (send homals-parent :active-homals-variables
                            (send show-status-file :text))
                         (send homals-parent :active-categories nil)
                         (send homals-parent :set-inds)
                         (send homals-parent :compute))
                        (format t "~%Invalid Solution Dimension!~%"))))))
        (bootstrap-button (send button-item-proto :new "Bootstrap"
                :action #'(lambda ()
                  (let ((num-boot (natural-numberp
                            (get-string-dialog "Number of Bootstraps:")))
                        (dim (send plot-dimension :text)))
                    (if (natural-numberp dim)
                        (progn
                         (send homals-parent :z-list nil)
                         (send homals-parent :p (floor (read-from-string dim)))
                         (send homals-parent :active-homals-variables
                            (send show-status-file :text))
                         (send homals-parent :set-inds)

                         (when num-boot
                          (dotimes (i num-boot)
                          (send homals-parent :set-sample)
                             (send homals-parent :compute
                                          :x (send homals-parent :z)
                                          :bootstrap 't
                                          :bootnum (1+ i)
                                          :original-data nil))
                             (send homals-parent :z-list
                                              (send homals-parent :z)))
                          (send homals-parent :compute
                                     :x (send homals-parent :z)
                                     :bootstrap 't)))))))
       )
  (send self :add-dialog-item (list (list ask-dimension plot-dimension)
                                    (list ask-status-name show-status-file)
                                    (list compute-button)))))

(defmeth homals-dialog-proto :add-read-data ()
 (let* (
        (homals-parent (send self :homals-parent))
        (tell-data-file (send text-item-proto :new "Data Filename: "))
        (show-data-file (send edit-text-item-proto :new "" :text-length 20))
        (seperator (send text-item-proto :new
          (make-string 52 :initial-element #\_)))
        (get-data-file (send button-item-proto :new "Load Data File"
                   :action #'(lambda ()
                    (let ((file (send show-data-file :text)))
                      (when (> (length file) 0)
                            (send homals-parent :data-matrix (apply #'bind-columns
                                       (read-data-columns file)))
                            (send homals-parent :initialize-slots)
                            (format t "~%Data file: ~a successfully loaded~%"
                                    file))))))
       )
    (send self :add-dialog-item 
           (list (list tell-data-file show-data-file)
                 (list get-data-file seperator)))))

(defmeth homals-dialog-proto :add-output ()
 (let* ((homals-parent (send self :homals-parent))
        (get-output-file (send button-item-proto :new "Output Options"
                   :action #'(lambda ()
                       (send self :output-options)))))
 (send self :add-dialog-item
     (list get-output-file) 't)))


(defmeth homals-dialog-proto :output-options ()
 (let* (
        (homals-parent (send self :homals-parent))
        (ask-dims (send text-item-proto :new
                      "[Optional] Dimensions to be used Filename:"))
        (get-dims (send edit-text-item-proto :new "" :text-length 20)) 
        (ask-output (send text-item-proto :new 
                "Type of output to write:"))
        (get-output (send choice-item-proto :new 
          (list "All Output" 
                "Optimally scaled data matrix"
                "Object Scores")))
        (ask-filename (send text-item-proto :new "Output Filename:"))
        (get-filename (send edit-text-item-proto :new
                   "" :text-length 20))
        (ok (send modal-button-proto :new "Ok"
               :action #'(lambda () 
                 (let ((output-file (send get-filename :text))
                       (val (send get-output :value)))
            (case val (0 (if (and (send homals-parent :z)
                                 (> (length output-file) 0))
                            (progn
                              (send homals-parent :homals-numerical-output
                                  output-file)
                              (format t
                              "~%Done Writing Output File: ~a~%" output-file))
                          (if (send homals-parent :z)
                           (format t "~%Error: No Output Filename!~%")
                           (format t "~%Error: No Solution Computed!~%"))))
                      (1 (if (and (send homals-parent :z)
                                 (> (length output-file) 0))
                          (progn
                           (let* ((dimfile (send get-dims :text))
                                  (dims (if (> (length dimfile) 0)
                                          (read-data-file dimfile)
                                          (repeat 1 (send homals-parent :m)))))
                            (send homals-parent :make-opt-dat-mat output-file)
                            (format t
                              "~%Done Writing Output File: ~a~%" output-file)))
                          (if (send homals-parent :z)
                           (format t "Error: No Output Filename!~%")
                           (format t "Error: No Solution Computed!~%"))))
                     (2 (if (and (send homals-parent :z)
                                 (> (length output-file) 0))
                         (progn
                          (send homals-parent :write-object-scores output-file)
                          (format t
                              "~%Done Writing Output File: ~a~%" output-file))
                          (if (send homals-parent :z)
                           (format t "Error: No Output Filename!~%")
                           (format t "Error: No Solution Computed!~%")))))))))
        (cancel (send modal-button-proto :new "Cancel"
                       :action #'(lambda () 
                          (send dialog :modal-dialog-return nil))))
        (dialog (send modal-dialog-proto :new 
                 (list (list ask-output get-output)
                       (list ask-filename get-filename)
;                       (list ask-dims get-dims)
                       (list ok cancel)))))
     (send dialog :modal-dialog)))
                       
    
(defmeth homals-dialog-proto :add-names-items ()
 (let* (
        (homals-parent (send self :homals-parent))
        (ask-obj-name (send text-item-proto :new
                      (pad-string "[Optional] Object Names Filename:" 37)))
        (show-obj-file (send edit-text-item-proto :new "" :text-length 20))
        (ask-var-name (send text-item-proto :new
                      (pad-string "[Optional] Variable Names Filename:" 37)))
        (show-var-file (send edit-text-item-proto :new "" :text-length 20))
        (seperator (send text-item-proto :new
             (make-string 50 :initial-element #\_)))
        (get-names-files (send button-item-proto :new "Get/Remove Files"
                       :action #'(lambda ()
            (send homals-parent :object-labels (send show-obj-file :text))
            (send homals-parent :variable-labels (send show-var-file :text)))))
       )
  (send self :add-dialog-item (list (list ask-obj-name show-obj-file)
                                    (list ask-var-name show-var-file)
                                    (list get-names-files seperator)))))

(defmeth homals-dialog-proto :add-start-plot ()
 (let* (
        (homals-parent (send self :homals-parent))
        (plot-dialog (send homals-plot-dialog-proto :new homals-parent))
        (plot-button (send button-item-proto :new "Fetch Plots"
            :action #'(lambda ()
                (let ((showing (send plot-dialog :showing)))
                   (if showing (send plot-dialog :hide-window)
                               (send plot-dialog :show-window))
                   (send plot-dialog :showing (not showing))))))
       )
   (send self :plot-dialog plot-dialog)
   (send self :add-dialog-item (list plot-button) 't)))

(defmeth homals-plot-dialog-proto :add-plot-items ()
 (let* (
        (homals-parent (send self :homals-parent))
        (plot-item (send choice-item-proto :new
                     (list "Star-Plot"
                           "Score-Plot"
                           "Individual Category Plots"
                           "Combined Category Plot"
                           "Combined Category and Object Plot"
                           "Discrimination Measure Plot"
                           "Variable Transformations") :value 0))
        (plot (send button-item-proto :new "Plot"
               :action #'(lambda ()
                (let* ((p (send homals-parent :p))
                       (val (send plot-item :value))
                       (get-dim (remove nil 
                                 (if (= val 6) 
                                     (get-dimension-dialog p 1)
                                     (get-dimension-dialog p)))))
                   (when get-dim
                      (let ((dims (if (> p 1)
                                      get-dim
                                      (error
                                           "Invalid Solution Dimension"))))
                      (send self :plot-redirect dims
                                           (send plot-item :value))))))))
       )
  (send self :add-dialog-item (list plot-item plot))))


(defmeth homals-dialog-proto :plot-redirect (dims selection)
 (let ((homals-parent (send self :homals-parent)))
   (case selection
                (0 (send star-plot-proto :new dims homals-parent))
                (1 (send score-plot-proto :new dims homals-parent))
                (2 (send category-plot-proto :new dims homals-parent))
                (3 (send combined-category-plot-proto :new dims homals-parent))
                (4 (send category-object-plot-proto :new dims homals-parent))
                (5 (send discrimination-plot-proto :new dims homals-parent))
                (6 (send transformation-plot-proto :new dims homals-parent)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Make specific plots, after convergence
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  :isnew Plot Constructor Method
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmeth plot-route-proto :isnew (dims homals-parent &rest args)
 (let (
       (plot (if (= (length dims) 3)
             (apply #'send homals-3d-plot-proto :new 3 args)
             (apply #'send homals-2d-plot-proto :new 2 args)))
       )
  (if (= (length dims) 1) (send plot :y-axis nil))
  (send self :homals-parent homals-parent)
  (send self :dims (if (every #'numberp dims) dims (rest dims)))
  (send self :plot plot)
  plot
))

(defmeth plot-route-proto :send-to-plot (&rest args)
  (let ((plot (send self :plot)))
  (apply #'send plot args)))

(defmeth plot-route-proto :cleanup ()
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Discrimination Plot Prototype
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmeth discrimination-plot-proto :isnew (dims homals-parent)
 (let ((plot (call-next-method dims homals-parent)))
  (send plot :plot-name "Discriminaton Measures")
  (send plot :setup dims self)))

(defmeth discrimination-plot-proto :make-point-labels ()
 (let* (
        (homals-parent (send self :homals-parent))
        (plot (send self :plot))
        (vl (select (send homals-parent :variable-labels)
                        (send homals-parent :active-homals-variables)))
       )
   (send plot :point-label (iseq (send plot :num-points)) vl)))
 
(defmeth discrimination-plot-proto :selected-points ()
 (let ((plot (send self :plot)))
  (send plot :point-selected (iseq (send plot :num-points)) t)))

(defmeth discrimination-plot-proto :make-lines (&optional point-list)
 (let* (
        (homals-parent (send self :homals-parent))
        (plot (send self :plot))
        (dims (send self :dims))
        (av (send homals-parent :active-homals-variables))
        (point-list (if point-list point-list (iseq (length av))))
        (d-m (send homals-parent :d-m))
       )
 (dolist (j point-list)
     (send plot :add-lines
         (mapcar #'(lambda (x) (list (aref (elt d-m j) x x) 0)) dims)))))

(defmeth discrimination-plot-proto :make-points ()
 (let* (
        (homals-parent (send self :homals-parent))
        (plot (send self :plot))
        (dims (send self :dims))
        (d-m (send homals-parent :d-m))
       )
 (dotimes (j (length d-m))
   (let ((d (elt d-m j)))
     (send plot :add-points
         (mapcar #'(lambda (x) (list (aref d x x))) dims))))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Category Quantifaction and Object Score Plot Prototype
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmeth category-object-plot-proto :isnew (dims homals-parent)
 (let ((plot (call-next-method dims homals-parent)))
   (send plot :plot-name "Combined Category and Object Plot")
   (send plot :setup dims self)))

(defmeth category-object-plot-proto :make-point-labels ()
 (let* (
        (homals-parent (send self :homals-parent))
        (plot (send self :plot))
        (dims (send self :dims))
        (z (break-columns (send homals-parent :z) dims))
        (yy (send homals-parent :k-j-list))
        (catlabel (mapcar #'(lambda (x) (iseq 1 x)) yy))
        (av (send homals-parent :active-homals-variables))
        (vl (select (send homals-parent :variable-labels) av))
        (pt-labels (combine (mapcar #'(lambda (x y) (mapcar #'(lambda (z)
                    (format nil "~a~a" x z)) y)) vl catlabel)))
        (ol (send homals-parent :object-labels))
      )
  (send plot :point-label (iseq (send plot :num-points)) 
                          (combine pt-labels ol))))


(defmeth category-object-plot-proto :selected-points ()
 (let ((plot (send self :plot))
       (n (send (send self :homals-parent) :n)))
    (send plot :point-selected
               (iseq (- (send plot :num-points) n)) t)))


(defmeth category-object-plot-proto :make-lines (&optional point-list)
 (let* (
        (homals-parent (send self :homals-parent))
        (plot (send self :plot))
        (dims (send self :dims))
        (p (length dims))
        (k (sum (send homals-parent :k-j-list)))
        (point-list (if point-list (select point-list (which (< point-list k)))
                                   (iseq k)))
        (yvars (select (transpose (map-elements #'coerce (select (column-list 
                         (send homals-parent :y)) dims) 'list)) point-list))
       )
   (mapcar #'(lambda (x) (send plot :add-lines 
               (transpose (list x (repeat 0 p))))) yvars)))

(defmeth category-object-plot-proto :make-points ()
 (let* (
        (homals-parent (send self :homals-parent))
        (plot (send self :plot))
        (dims (send self :dims))
        (n (send homals-parent :n))
        (yvars (map-elements #'coerce 
                   (select (column-list (send homals-parent :y)) dims) 'list))
        (z (break-columns (send homals-parent :z) dims))
        (ylen (length (first yvars)))
       )
 (send plot :add-points yvars)
 (send plot :add-points (column-list z))
 (send plot :point-symbol (iseq ylen (+ ylen n (- 1))) 'x)))
